1. Veri Yükleme ve Dönüşüm İşlemleri

library(readxl)
data <- read_excel("C:/Users/osman/OneDrive/Masaüstü/heart_failure_clinical_records.xlsx")
data <- as.data.frame(data)
head(data)
##   age anaemia creatinine_phosphokinase diabetes ejection_fraction
## 1  75       0                      582        0                20
## 2  55       0                     7861        0                38
## 3  65       0                      146        0                20
## 4  50       1                      111        0                20
## 5  65       1                      160        1                20
## 6  90       1                       47        0                40
##   high_blood_pressure platelets serum_creatinine serum_sodium sex smoking time
## 1                   1    265000              1.9          130   1       0    4
## 2                   0    263358              1.1          136   1       0    6
## 3                   0    162000              1.3          129   1       1    7
## 4                   0    210000              1.9          137   1       0    7
## 5                   0    327000              2.7          116   0       0    8
## 6                   1    204000              2.1          132   1       1    8
##   DEATH_EVENT
## 1           1
## 2           1
## 3           1
## 4           1
## 5           1
## 6           1

readx1 paketindeki, read_excel fonksiyonunu kullanarak veri setini yükledik ve yapmış olduğumuz bu işlemi data adlı bir değişkene atadık. as.data.frame fonksiyonunu kullanarak data isimli veri setimizi data frame formatına çevirdik. head fonksiyonunu kullanarak veri setinde yer alan değişkenlerin ilk 6 gözlemini elde ettik ve değişkenleri inceledik. Değişkenlerin 7’si nicel, 6’sı kategorik verilerden oluşmaktadır.

data$anaemia <- factor(data$anaemia,levels = c("0","1"),labels = c("No","Yes"))
data$diabetes <- factor(data$diabetes,levels = c("0","1"),labels = c("No","Yes"))
data$high_blood_pressure <- factor(data$high_blood_pressure,levels = c("0","1"),labels = c("No","Yes"))
data$sex <- factor(data$sex,levels = c("0","1"),labels = c("Female","Male"))
data$smoking <- factor(data$smoking,levels = c("0","1"),labels = c("No","Yes"))
data$DEATH_EVENT <- factor(data$DEATH_EVENT,levels = c("0","1"),labels = c("No","Yes"))

Veri setindeki kategorik değişkenleri faktör olarak tanımladık. Bu işlemi factor fonksiyonunu kullanarak gerçekleştirdik.

summary(data)
##       age        anaemia   creatinine_phosphokinase diabetes  ejection_fraction
##  Min.   :40.00   No :170   Min.   :  23.0           No :174   Min.   :14.00    
##  1st Qu.:51.00   Yes:129   1st Qu.: 116.5           Yes:125   1st Qu.:30.00    
##  Median :60.00             Median : 250.0                     Median :38.00    
##  Mean   :60.83             Mean   : 581.8                     Mean   :38.08    
##  3rd Qu.:70.00             3rd Qu.: 582.0                     3rd Qu.:45.00    
##  Max.   :95.00             Max.   :7861.0                     Max.   :80.00    
##  high_blood_pressure   platelets      serum_creatinine  serum_sodium  
##  No :194             Min.   : 25100   Min.   :0.500    Min.   :113.0  
##  Yes:105             1st Qu.:212500   1st Qu.:0.900    1st Qu.:134.0  
##                      Median :262000   Median :1.100    Median :137.0  
##                      Mean   :263358   Mean   :1.394    Mean   :136.6  
##                      3rd Qu.:303500   3rd Qu.:1.400    3rd Qu.:140.0  
##                      Max.   :850000   Max.   :9.400    Max.   :148.0  
##      sex      smoking        time       DEATH_EVENT
##  Female:105   No :203   Min.   :  4.0   No :203    
##  Male  :194   Yes: 96   1st Qu.: 73.0   Yes: 96    
##                         Median :115.0              
##                         Mean   :130.3              
##                         3rd Qu.:203.0              
##                         Max.   :285.0

Veri dönüştürme işlemlerini gerçekleştirdikten sonra, summary fonksiyonunu kullanarak değişkenlerle ilgili özet bilgileri elde ettik.

2. Eksik Gözlemler

rowSums(is.na(data))
##   [1] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
##  [38] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
##  [75] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [112] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [149] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [186] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [223] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [260] 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
## [297] 0 0 0
colSums(is.na(data))
##                      age                  anaemia creatinine_phosphokinase 
##                        0                        0                        0 
##                 diabetes        ejection_fraction      high_blood_pressure 
##                        0                        0                        0 
##                platelets         serum_creatinine             serum_sodium 
##                        0                        0                        0 
##                      sex                  smoking                     time 
##                        0                        0                        0 
##              DEATH_EVENT 
##                        0

is.na, rowSums ve colSums fonksiyonlarını kullanarak veri setimizde satır ve sütün bazında eksik veri içerip içermediğini inceledik. Veri setimiz satır ve sütün bazında eksik veri içermemektedir. Bu nedenle veri setimiz için rastgele bir şekilde eksik veri oluşturalım.

data_miss <- data

Eksik veri oluşturmaya başlamadan önce orijinal veri setimizi data_miss isimli bir değişkene atayarak bir kopyasını elde ettik. Eksik veri oluşturma işlemlerimizi data_miss veri seti üzerinden gerçekleştireceğiz.

data_miss[sample(1:nrow(data_miss),floor(nrow(data_miss)*0.05)),"age"]<- NA
data_miss[sample(1:nrow(data_miss),floor(nrow(data_miss)*0.07)),"diabetes"]<- NA
data_miss[sample(1:nrow(data_miss),floor(nrow(data_miss)*0.05)),"ejection_fraction"]<- NA
data_miss[sample(1:nrow(data_miss),floor(nrow(data_miss)*0.07)),"high_blood_pressure"]<- NA
data_miss[sample(1:nrow(data_miss),floor(nrow(data_miss)*0.09)),"smoking"]<- NA

age, diabetes, ejection_fraction, high_blood_pressure ve smoking değişkenleri için eksik veri oluşturduk. Bu işlemden sonra mice paketindeki md.pattern fonksiyonunu kullanarak eksik verilerimizin yapısını inceleyelim.

library(mice)
## 
## Attaching package: 'mice'
## The following object is masked from 'package:stats':
## 
##     filter
## The following objects are masked from 'package:base':
## 
##     cbind, rbind
md.pattern(data_miss[,c("age","diabetes","ejection_fraction","high_blood_pressure","smoking","DEATH_EVENT")],rotate.names = TRUE)

##     DEATH_EVENT age ejection_fraction diabetes high_blood_pressure smoking   
## 212           1   1                 1        1                   1       1  0
## 23            1   1                 1        1                   1       0  1
## 18            1   1                 1        1                   0       1  1
## 17            1   1                 1        0                   1       1  1
## 1             1   1                 1        0                   1       0  2
## 1             1   1                 1        0                   0       1  2
## 11            1   1                 0        1                   1       1  1
## 1             1   1                 0        1                   1       0  2
## 1             1   1                 0        0                   1       1  2
## 11            1   0                 1        1                   1       1  1
## 1             1   0                 1        1                   1       0  2
## 1             1   0                 1        1                   0       1  2
## 1             1   0                 0        1                   1       1  2
##               0  14                14       20                  20      26 94

md.pattern fonksiyonu ile oluşturduğumuz grafikte mavi hücreler dolu gözlemleri, pembe hücreler ise eksik gözlemleri temsil etmektedir. Grafiğin sol tarafındaki sayılar değişkenlere ait olan hücrelerdeki eksik ve dolu gözlem sayısını, sağ tarafındaki sayılar ise eksik gözleme sahip olan değişken sayısını ifade etmektedir. Grafiğin altında yer alan sayılar ise değişkenlere ait toplam eksik gözlem sayısını belirtmektedir. data_miss veri setimize ait grafiği incelediğimizde DEATH_EVENT değişkeninde eksik gözlem bulunmadığı, age ve ejection_fraction değişkenlerinde 14, diabetes ve high_blood_pressure değişkenlerinde 20, smoking değişkeninde ise 26 eksik gözlem olduğu gözlemlenmiştir. Tüm bu gözlemler sonucunda data_miss veri setimizde 94 eksik gözlem olduğu belirlenmiştir.

library(DMwR2)
## Registered S3 method overwritten by 'quantmod':
##   method            from
##   as.zoo.data.frame zoo
anyNA(data_miss) 
## [1] TRUE
data_knn<-knnImputation(data_miss, k=7, meth="median")
anyNA(data_knn)
## [1] FALSE

K-Nearest Neighbor tahmine dayalı yönteminden yararlanmak için DMwR2 paketini çağırdık. anyNA fonksiyonu ile data_miss verisetinin eksik gözlem içerip içermediğini kontrol ettik ve data_miss veri setinin eksik gözlem içerdiği bilgisine ulaştık. knnImputation fonksiyonunu kullanarak data_miss verisetindeki eksik gözlemleri en yakın 7 komşusunun ortanca değerini alacak şekilde doldurduk ve bu işlemi data_knn adlı değişkene atadık. anyNA fonksiyonu ile data_knn verisetinin eksik gözlem içerip içermediğini kontrol ettik ve data_knn veri setinin eksik gözlem içermediği bilgisine ulaştık.

a<-which(is.na(data_miss$age))
data_knn$age[a]
##  [1] 70 70 69 60 65 61 63 65 70 60 60 55 61 60
data$age[a]
##  [1] 75 65 49 72 75 55 72 46 80 45 59 70 70 62
b<-which(is.na(data_miss$diabetes))
data_knn$diabetes[b]
##  [1] No  No  No  No  No  No  No  No  No  No  Yes No  No  Yes Yes Yes No  No  Yes
## [20] Yes
## Levels: No Yes
data$diabetes[b]
##  [1] No  No  Yes No  Yes Yes Yes No  Yes No  Yes No  Yes No  Yes Yes Yes No  No 
## [20] Yes
## Levels: No Yes
c<-which(is.na(data_miss$ejection_fraction))
data_knn$ejection_fraction[c]
##  [1] 25 38 38 38 40 40 45 35 35 40 40 38 38 38
data$ejection_fraction[c]
##  [1] 25 38 50 20 60 60 25 30 40 40 40 25 25 35
d<-which(is.na(data_miss$high_blood_pressure))
data_knn$high_blood_pressure[d]
##  [1] Yes No  No  No  Yes No  No  No  No  No  No  No  No  No  No  No  No  No  No 
## [20] Yes
## Levels: No Yes
data$high_blood_pressure[d]
##  [1] No  No  Yes Yes Yes No  No  No  No  No  No  Yes No  No  Yes No  No  No  No 
## [20] No 
## Levels: No Yes
e<-which(is.na(data_miss$smoking))
data_knn$smoking[e]
##  [1] No  No  No  No  No  Yes Yes No  No  Yes No  No  No  No  No  No  Yes No  No 
## [20] No  No  No  No  No  No  Yes
## Levels: No Yes
data$smoking[e]
##  [1] No  No  Yes No  No  No  No  No  No  No  No  Yes No  No  No  Yes Yes No  Yes
## [20] No  No  Yes No  Yes No  Yes
## Levels: No Yes

which ve is.na fonksiyonlarını kullanarak data_miss veri setimizde eksik gözlem içeren değişkenlerimizin sıra numaralarına ulaştık ve bunları “a,b,c,d,e” isimli değişkenlere atadık. Sonrasında data_knn veri setinde doldurmuş olduğumuz eksik gözlemlerin ve data verisetindeki orijinal gözlemlerin sıra numarasına ulaşmak için, “a,b,c,d,e” değişkenlerinden yararlanarak data_knn verisetinde doldurmuş olduğumuz gözlemlere ve data verisetindeki orijinal verilere ulaştık. data_knn ve data verisetlerinden elde ettiğimiz gözlemleri karşılaştırarak doldurma işlemimizin doğruluğunu test ettik.

3. Train & Test Veri Kümeleri

library(caret)
## Zorunlu paket yükleniyor: ggplot2
## Zorunlu paket yükleniyor: lattice
set.seed(74367432)
train_id<-createDataPartition(data$DEATH_EVENT, p=0.80, list=FALSE, times=1)

caret paketindeki createDataPartition fonnksiyonunu kullanarak, data veri setimizin train ve test veri kümelerine hangi yüzdeliklerle ayrılacağını belirlemek için train_id adlı değişkeni oluşturduk.

train<-data[train_id,]
test<-data[-train_id,]

train_id değişkeninden yararlanarak train ve test veri kümelerimizi oluşturduk.

library("openxlsx")
write.xlsx(train, 'train.xlsx')
write.xlsx(test, 'test.xlsx')

openxlsx paketindeki write.xlsx fonksiyonundan yararlanarak, train ve test veri kümelerimizi yazdırdık.

library(dplyr)
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
glimpse(train)
## Rows: 240
## Columns: 13
## $ age                      <dbl> 50, 65, 90, 60, 65, 80, 62, 45, 50, 49, 82, 8~
## $ anaemia                  <fct> Yes, Yes, Yes, Yes, No, Yes, No, Yes, Yes, Ye~
## $ creatinine_phosphokinase <dbl> 111, 160, 47, 315, 157, 123, 231, 981, 168, 8~
## $ diabetes                 <fct> No, Yes, No, Yes, No, No, No, No, No, No, No,~
## $ ejection_fraction        <dbl> 20, 20, 40, 60, 65, 35, 25, 30, 38, 30, 50, 3~
## $ high_blood_pressure      <fct> No, No, Yes, No, No, Yes, Yes, No, Yes, Yes, ~
## $ platelets                <dbl> 210000, 327000, 204000, 454000, 263358, 38800~
## $ serum_creatinine         <dbl> 1.90, 2.70, 2.10, 1.10, 1.50, 9.40, 0.90, 1.1~
## $ serum_sodium             <dbl> 137, 116, 132, 131, 138, 133, 140, 137, 137, ~
## $ sex                      <fct> Male, Female, Male, Male, Female, Male, Male,~
## $ smoking                  <fct> No, No, Yes, Yes, No, Yes, Yes, No, No, No, N~
## $ time                     <dbl> 7, 8, 8, 10, 10, 10, 10, 11, 11, 12, 13, 14, ~
## $ DEATH_EVENT              <fct> Yes, Yes, Yes, Yes, Yes, Yes, Yes, Yes, Yes, ~

dplyr paketindeki glimpse fonksiyonunu kullanarak train veri kümemizin yapısını inceledik.

train$ejf_kat<-ifelse(train$ejection_fraction < 35, "Düsük", ifelse(train$ejection_fraction >= 35 & train$ejection_fraction <= 55,"Normal","Yüksek"))

train$srs_kat<-ifelse(train$serum_sodium < 135, "Düsük", ifelse(train$serum_sodium >= 135 & train$serum_sodium <=  145,"Normal","Yüksek"))

train veri kümesindeki ejection_fraction ve serum_sodium değişkenlerinden yeni gruplanmış kategorik değişkenler türettik.

train$ejf_kat<-factor(train$ejf_kat, levels=c("Düsük","Normal","Yüksek"))
train$srs_kat<-factor(train$srs_kat, levels=c("Düsük","Normal","Yüksek"))

Türetilen kategorik değişkenleri factor olarak tanımladık.

glimpse(train)
## Rows: 240
## Columns: 15
## $ age                      <dbl> 50, 65, 90, 60, 65, 80, 62, 45, 50, 49, 82, 8~
## $ anaemia                  <fct> Yes, Yes, Yes, Yes, No, Yes, No, Yes, Yes, Ye~
## $ creatinine_phosphokinase <dbl> 111, 160, 47, 315, 157, 123, 231, 981, 168, 8~
## $ diabetes                 <fct> No, Yes, No, Yes, No, No, No, No, No, No, No,~
## $ ejection_fraction        <dbl> 20, 20, 40, 60, 65, 35, 25, 30, 38, 30, 50, 3~
## $ high_blood_pressure      <fct> No, No, Yes, No, No, Yes, Yes, No, Yes, Yes, ~
## $ platelets                <dbl> 210000, 327000, 204000, 454000, 263358, 38800~
## $ serum_creatinine         <dbl> 1.90, 2.70, 2.10, 1.10, 1.50, 9.40, 0.90, 1.1~
## $ serum_sodium             <dbl> 137, 116, 132, 131, 138, 133, 140, 137, 137, ~
## $ sex                      <fct> Male, Female, Male, Male, Female, Male, Male,~
## $ smoking                  <fct> No, No, Yes, Yes, No, Yes, Yes, No, No, No, N~
## $ time                     <dbl> 7, 8, 8, 10, 10, 10, 10, 11, 11, 12, 13, 14, ~
## $ DEATH_EVENT              <fct> Yes, Yes, Yes, Yes, Yes, Yes, Yes, Yes, Yes, ~
## $ ejf_kat                  <fct> Düsük, Düsük, Normal, Yüksek, Yüksek, Normal,~
## $ srs_kat                  <fct> Normal, Düsük, Düsük, Düsük, Normal, Düsük, N~

Yeni değişken türetme ve dönüşüm işlemlerinden sonra glimpse fonksiyonu ile train veri kümesinin yapısını yeniden inceledik.

4. Verilerin Açıklayıcı/Keşfedici Çözümlemesi

library(funModeling)
## Zorunlu paket yükleniyor: Hmisc
## Zorunlu paket yükleniyor: survival
## 
## Attaching package: 'survival'
## The following object is masked from 'package:caret':
## 
##     cluster
## Zorunlu paket yükleniyor: Formula
## 
## Attaching package: 'Hmisc'
## The following objects are masked from 'package:dplyr':
## 
##     src, summarize
## The following objects are masked from 'package:base':
## 
##     format.pval, units
## funModeling v.1.9.4 :)
## Examples and tutorials at livebook.datascienceheroes.com
##  / Now in Spanish: librovivodecienciadedatos.ai
profiling_num(train)
##                   variable         mean      std_dev variation_coef      p_01
## 1                      age     60.87083    11.720417     0.19254570    40.000
## 2 creatinine_phosphokinase    543.43333   886.461465     1.63122394    47.000
## 3        ejection_fraction     37.99583    11.742174     0.30903846    18.170
## 4                platelets 266228.45200 99663.995430     0.37435516 65120.000
## 5         serum_creatinine      1.39275     1.061510     0.76216859     0.639
## 6             serum_sodium    136.77917     4.563497     0.03336398   122.170
## 7                     time    130.23333    77.740609     0.59693326     8.780
##        p_05      p_25     p_50      p_75       p_95      p_99   skewness
## 1     43.95     52.00     60.0     68.25     82.000     92.44  0.4859066
## 2     58.95    113.00    231.0    582.00   2070.050   4723.45  4.4200809
## 3     20.00     30.00     38.0     45.00     60.000     61.22  0.4874253
## 4 135850.00 212750.00 263179.0 304000.00 448150.000 539100.00  1.5251769
## 5      0.70      0.90      1.1      1.40      2.905      6.41  4.6269940
## 6    130.00    134.00    137.0    140.00    144.000    145.00 -1.1945801
## 7     14.00     72.75    112.5    205.00    250.000    275.27  0.1370103
##    kurtosis      iqr                  range_98         range_80
## 1  3.054171    16.25    [40, 92.4399999999999]       [45, 75.2]
## 2 28.611651   469.00    [47, 4723.44999999998]     [66, 1199.3]
## 3  2.662647    15.00            [18.17, 61.22]         [25, 60]
## 4  9.387101 91250.00           [65120, 539100] [159500, 388100]
## 5 30.027941     0.50 [0.639, 6.40999999999999]       [0.8, 2.1]
## 6  7.528240     6.00             [122.17, 145]       [132, 142]
## 7  1.764446   132.25            [8.78, 275.27]    [26.9, 241.3]
plot_num(train)
## Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> =
## "none")` instead.

funmodeling paketindeki profiling_num ve plot_num fonksiyonlarını kullanarak train veri kümemizdeki nicel değişkenlere ait özet istatistikleri ve grafikleri elde ettik. Özet istatistikleri ve grafikleri incelediğimizde creatinine_phosphokinase, serum_creatinine ve platelets değişkenlerinin sağa çarpık olduğunu, serum_sodium değişkeninin sola çarpık olduğunu, age ve time değişkenlerinin ise homojen bir şekilde dağıldığını söyleyebiliriz.

freq(train)
## Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> =
## "none")` instead.
##   anaemia frequency percentage cumulative_perc
## 1      No       132         55              55
## 2     Yes       108         45             100
## Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> =
## "none")` instead.

##   diabetes frequency percentage cumulative_perc
## 1       No       131      54.58           54.58
## 2      Yes       109      45.42          100.00
## Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> =
## "none")` instead.

##   high_blood_pressure frequency percentage cumulative_perc
## 1                  No       153      63.75           63.75
## 2                 Yes        87      36.25          100.00
## Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> =
## "none")` instead.

##      sex frequency percentage cumulative_perc
## 1   Male       153      63.75           63.75
## 2 Female        87      36.25          100.00
## Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> =
## "none")` instead.

##   smoking frequency percentage cumulative_perc
## 1      No       167      69.58           69.58
## 2     Yes        73      30.42          100.00
## Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> =
## "none")` instead.

##   DEATH_EVENT frequency percentage cumulative_perc
## 1          No       163      67.92           67.92
## 2         Yes        77      32.08          100.00
## Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> =
## "none")` instead.

##   ejf_kat frequency percentage cumulative_perc
## 1  Normal       134      55.83           55.83
## 2   Düsük        77      32.08           87.91
## 3  Yüksek        29      12.08          100.00
## Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> =
## "none")` instead.

##   srs_kat frequency percentage cumulative_perc
## 1  Normal       176      73.33           73.33
## 2   Düsük        62      25.83           99.16
## 3  Yüksek         2       0.83          100.00
## [1] "Variables processed: anaemia, diabetes, high_blood_pressure, sex, smoking, DEATH_EVENT, ejf_kat, srs_kat"

funmodeling paketi içerisinde yer alan freq fonksiyonunu kullanarak kategorik değişkenlerimizin frekans ve frekans oranlarını içeren grafikleri elde ettik.

library(psych)
## 
## Attaching package: 'psych'
## The following object is masked from 'package:Hmisc':
## 
##     describe
## The following objects are masked from 'package:ggplot2':
## 
##     %+%, alpha
library(dplyr)
library(ggplot2)

df<-select(train,time,srs_kat)
describeBy(df, df$srs_kat)
## 
##  Descriptive statistics by group 
## group: Düsük
##          vars  n   mean    sd median trimmed    mad min max range skew kurtosis
## time        1 62 116.06 79.23   93.5  114.46 100.82   8 250   242 0.17    -1.54
## srs_kat*    2 62   1.00  0.00    1.0    1.00   0.00   1   1     0  NaN      NaN
##             se
## time     10.06
## srs_kat*  0.00
## ------------------------------------------------------------ 
## group: Normal
##          vars   n   mean    sd median trimmed   mad min max range skew kurtosis
## time        1 176 135.27 76.75    116  134.53 98.59   7 285   278 0.14    -1.18
## srs_kat*    2 176   2.00  0.00      2    2.00  0.00   2   2     0  NaN      NaN
##            se
## time     5.79
## srs_kat* 0.00
## ------------------------------------------------------------ 
## group: Yüksek
##          vars n mean     sd median trimmed    mad min max range skew kurtosis
## time        1 2  126 117.38    126     126 123.06  43 209   166    0    -2.75
## srs_kat*    2 2    3   0.00      3       3   0.00   3   3     0  NaN      NaN
##          se
## time     83
## srs_kat*  0
ggplot(train, aes(x=srs_kat,y=time, fill=srs_kat))+
  geom_boxplot()+
  stat_summary(fun = median, geom="line", group= 1, color= "black", size = 1.25)    

Hasta takip süresinin (time değişkeni),kandaki serum sodyum seviyesi (srs_kat değişkeni) bazında özet istatistiklerini ve boxplot grafiğini elde ettik. Özet istatistikleri incelediğimizde kategorilerde düsük’ten yüksek’e doğru geçiş sağlandığında ortanca oranı arttıkça standart sapmanın da artış gösterdiği görülmekte, buna göre hastanın takip süresi ile kandaki serum sodyum seviyesi arasında doğrusal bir ilişkinin var olduğundan söz edebiliriz. Boxplot grafiklerini incelediğimizde kategorilerde düsük’ten yüksek’e doğru geçiş sağlandığında kutu genişliklerinin gittikçe küçüldüğü görülmekte, buna göre değişen varyanslılığın varlığından söz edebiliriz.

quantile(train$ejection_fraction)
##   0%  25%  50%  75% 100% 
##   14   30   38   45   70
ejection_fraction_min <- as.vector(quantile(train$ejection_fraction,0.00))
ejection_fraction_q1 <- as.vector(quantile(train$ejection_fraction,0.25))
ejection_fraction_median <- as.vector(quantile(train$ejection_fraction,0.50))
ejection_fraction_q3 <- as.vector(quantile(train$ejection_fraction,0.75))
ejection_fraction_max <- as.vector(quantile(train$ejection_fraction,1.00))
quantile(train$serum_sodium)
##   0%  25%  50%  75% 100% 
##  113  134  137  140  148
serum_sodium_min <- as.vector(quantile(train$serum_sodium,0.00))
serum_sodium_q1 <- as.vector(quantile(train$serum_sodium,0.25))
serum_sodium_median <- as.vector(quantile(train$serum_sodium,0.50))
serum_sodium_q3 <- as.vector(quantile(train$serum_sodium,0.75))
serum_sodium_max <- as.vector(quantile(train$serum_sodium,1.00))

Train veri kümemimize ait ejection_fraction ve serum_sodium nicel değişkenlerinin 5 nokta ölçülerini (mimimum, Q1, medyan, Q3, maksimum) hesapladık ve bu değerleri değişkenlere atadık. Bu değişkenlerden yararlanarak, ejection_fraction ve serum_sodium değişkenlerimiz için DAG ve Genişlik ölçülerini hesaplayacağız.

ejection_fraction_DAG <- ejection_fraction_q3 - ejection_fraction_q1
ejection_fraction_DAG
## [1] 15
ejection_fraction_Genislik <- ejection_fraction_max - ejection_fraction_min
ejection_fraction_Genislik
## [1] 56
serum_sodium_DAG <- serum_sodium_q3 - serum_sodium_q1
serum_sodium_DAG
## [1] 6
serum_sodium_Genislik <- serum_sodium_max - serum_sodium_min
serum_sodium_Genislik
## [1] 35

ejection_fraction ve serum_sodium değişkenlerimize ait DAG ve Genişlik ölçülerini elde ettik ve bunları değişkenlere atadık. (ejection_fraction_DAG - ejection_fraction_Genislik - serum_sodium_DAG - serum_sodium_Genislik)

stdev<-sd(train$age)
mean<-mean(train$age)
Degisim_kats_age<-(stdev/mean)*100
Degisim_kats_age
## [1] 19.25457

Train veri kümemizdeki age değişkeni için değişim katsayısı hesapladık. Age değişkeni için yaklaşık %20’lik bir değişim katsayısı elde ettik. Bu sonuca göre age değişkeninin yaklaşık simetrik olduğunu söyleyebiliriz.

sd_dk <- function(x) {c(std<-sd(x), dk<-(sd(x)/mean(x))*100)}
tapply(train$time, train$sex,sd_dk)
## $Female
## [1] 79.29039 59.35522
## 
## $Male
## [1] 77.04269 60.03633

sex değişkenine göre time değişkeninin standart sapmasını ve değişim katsayısını hesapladık. Elde ettiğimiz değişim katsayısı değerlerini incelediğimizde, kadınların time değişkenindeki yayılımının, erkeklere göre daha fazla olduğunu söyleyebiliriz.

sort <- train[order(train$age),]
medianf<-median(sort$age)
sort$fmed<-abs(sort$age-medianf)
sort2 <- sort[order(sort$fmed),]
mad<-median(sort2$fmed)
mad
## [1] 8

Train veri kümemizdeki age değişkeni için ortalama/ortanca mutlak sapma (mad) değerini hesapladık. Elde ettiğimiz mad değeri küçük olduğu için age değişkeni içerisindeki değerlerin ortalama çevresinde birbirine yakın kümelendiklerini söyleyebiliriz.

sol_kuyruk <- function(x) {
  c(quantile(x,probs=1/2) , 
    quantile(x,probs=1/4),
    quantile(x,probs=1/8 ),
    quantile(x,probs=1/16),
    quantile(x,probs=1/32),
    quantile(x,probs=1/64)
  )
}
sag_kuyruk <- function(x) {
  c(quantile(x,probs=1/2) , 
    quantile(x,probs=3/4),
    quantile(x,probs=7/8),
    quantile(x,probs=15/16),
    quantile(x,probs=31/32),
    quantile(x,probs=63/64)
  )
}

sol kuyruk ve sağ kuyruk değişkenleri oluşturuldu.

y<-tapply(train$time, train$sex, sol_kuyruk)
mrg_cins<-as.data.frame(cbind(y[[1]],y[[2]]))
colnames(mrg_cins)<-c("Female","Male")
mrg_cins$Fark<-abs(mrg_cins$Female-mrg_cins$Male)
mrg_cins
##           Female   Male   Fark
## 50%     115.0000 112.00 3.0000
## 25%      74.0000  72.00 2.0000
## 12.5%    30.0000  30.00 0.0000
## 6.25%    21.1250  17.00 4.1250
## 3.125%   14.0625  10.75 3.3125
## 1.5625%  10.6875  10.00 0.6875

Cinsiyete göre sol kuyruk incelemesi gerçekleştirildi.

x_a<-sol_kuyruk(train$ejection_fraction)
x_u<-sag_kuyruk(train$ejection_fraction)
x_mrg<-as.data.frame(cbind(x_a,x_u))
rownames(x_mrg)<-c("1/2","1/4","1/8","1/16","1/32","1/64")
colnames(x_mrg)<-c("Alt_Kuyruk","Ust_Kuyruk")
x_mrg$orta_nokta<-(x_mrg$Alt_Kuyruk+x_mrg$Ust_Kuyruk)/2
x_mrg
##      Alt_Kuyruk Ust_Kuyruk orta_nokta
## 1/2          38         38       38.0
## 1/4          30         45       37.5
## 1/8          25         55       40.0
## 1/16         20         60       40.0
## 1/32         20         60       40.0
## 1/64         20         60       40.0
hist(train$ejection_fraction)

x_a<-sol_kuyruk(train$serum_sodium)
x_u<-sag_kuyruk(train$serum_sodium)
x_mrg<-as.data.frame(cbind(x_a,x_u))
rownames(x_mrg)<-c("1/2","1/4","1/8","1/16","1/32","1/64")
colnames(x_mrg)<-c("Alt_Kuyruk","Ust_Kuyruk")
x_mrg$orta_nokta<-(x_mrg$Alt_Kuyruk+x_mrg$Ust_Kuyruk)/2
x_mrg
##      Alt_Kuyruk Ust_Kuyruk orta_nokta
## 1/2    137.0000   137.0000   137.0000
## 1/4    134.0000   140.0000   137.0000
## 1/8    132.0000   141.0000   136.5000
## 1/16   130.0000   143.0625   136.5312
## 1/32   127.0000   145.0000   136.0000
## 1/64   124.7344   145.0000   134.8672
hist(train$serum_sodium)

Train veri kümemizdeki ejection_fraction ve serum_sodium değişkenleri için kuyruk uzunlukları ve histogram grafikleri elde edilmiştir. Elde edilen sonuçlar incelendiğinde ejection_fraction değişkeninin simetrik’e yakın, serum_sodium değişkeninin ise sola çarpık dağıldığını söyleyebiliriz.

p<-0.1
mean(train$serum_sodium, trim = p)
## [1] 137.0052
n<-nrow(train$serum_sodium)
ks<- n-(as.integer(2*p*n)) 
ks
## integer(0)
geometric.mean(train$serum_sodium)
## [1] 136.701

Train veri kümemizdeki serum_sodium değişkenine ait kesilmiş ortalama, kalan gözlem sayısı ve geometrik ortalama hesaplandı.

table(train$sex)
## 
## Female   Male 
##     87    153
freq <- as.data.frame(table(train$sex))
names(freq)[1] <- 'sex'
freq
##      sex Freq
## 1 Female   87
## 2   Male  153
gini <- function(a,b) {
  a1 <- (a/(a+b))**2
  b1 <- (b/(a+b))**2
  x<-1-(a1 + b1)
  return(x)
}
gn<-gini(freq[1,2],freq[2,2])
k<-2
gn/((k-1)/k)
## [1] 0.924375
table(train$smoking)
## 
##  No Yes 
## 167  73
freq <- as.data.frame(table(train$smoking))
names(freq)[1] <- 'smoking'
freq
##   smoking Freq
## 1      No  167
## 2     Yes   73
gini <- function(a,b) {
  a1 <- (a/(a+b))**2
  b1 <- (b/(a+b))**2
  x<-1-(a1 + b1)
  return(x)
}
gn<-gini(freq[1,2],freq[2,2])
k<-2
gn/((k-1)/k)
## [1] 0.8465972
table(train$DEATH_EVENT)
## 
##  No Yes 
## 163  77
freq <- as.data.frame(table(train$DEATH_EVENT))
names(freq)[1] <- 'death_event'
freq
##   death_event Freq
## 1          No  163
## 2         Yes   77
gini <- function(a,b) {
  a1 <- (a/(a+b))**2
  b1 <- (b/(a+b))**2
  x<-1-(a1 + b1)
  return(x)
}
gn<-gini(freq[1,2],freq[2,2])
k<-2
gn/((k-1)/k)
## [1] 0.8715972

Train veri kümemizdeki sex, smoking ve DEATH_EVENT değişkenleri için gini indeksleri hesaplandı. sex, smoking ve DEATH_EVENT değişkenlerine ait gini indeksleri 1’e yakın değer aldılar. Bu sonuçları göz önünde bulundurduğumuzda sex, smoking ve DEATH_EVENT değişkenlerinin hetorejen bir şekilde dağıldıklarını söyleyebiliriz.

train$hastalik <- ifelse(train$high_blood_pressure == "Yes", "Hasta","HDeğil")
train$hastalik <- as.factor(train$hastalik)

Train veri kümemizdeki high_blood_pressure değişkeninden yararlanarak, hastalik isimli yeni bir değişken oluşturduk. hastalik değişkenini factor formatına çevirdik.

glimpse(train)
## Rows: 240
## Columns: 16
## $ age                      <dbl> 50, 65, 90, 60, 65, 80, 62, 45, 50, 49, 82, 8~
## $ anaemia                  <fct> Yes, Yes, Yes, Yes, No, Yes, No, Yes, Yes, Ye~
## $ creatinine_phosphokinase <dbl> 111, 160, 47, 315, 157, 123, 231, 981, 168, 8~
## $ diabetes                 <fct> No, Yes, No, Yes, No, No, No, No, No, No, No,~
## $ ejection_fraction        <dbl> 20, 20, 40, 60, 65, 35, 25, 30, 38, 30, 50, 3~
## $ high_blood_pressure      <fct> No, No, Yes, No, No, Yes, Yes, No, Yes, Yes, ~
## $ platelets                <dbl> 210000, 327000, 204000, 454000, 263358, 38800~
## $ serum_creatinine         <dbl> 1.90, 2.70, 2.10, 1.10, 1.50, 9.40, 0.90, 1.1~
## $ serum_sodium             <dbl> 137, 116, 132, 131, 138, 133, 140, 137, 137, ~
## $ sex                      <fct> Male, Female, Male, Male, Female, Male, Male,~
## $ smoking                  <fct> No, No, Yes, Yes, No, Yes, Yes, No, No, No, N~
## $ time                     <dbl> 7, 8, 8, 10, 10, 10, 10, 11, 11, 12, 13, 14, ~
## $ DEATH_EVENT              <fct> Yes, Yes, Yes, Yes, Yes, Yes, Yes, Yes, Yes, ~
## $ ejf_kat                  <fct> Düsük, Düsük, Normal, Yüksek, Yüksek, Normal,~
## $ srs_kat                  <fct> Normal, Düsük, Düsük, Düsük, Normal, Düsük, N~
## $ hastalik                 <fct> HDeğil, HDeğil, Hasta, HDeğil, HDeğil, Hasta,~

Değişken oluşturma ve dönüşüm işlemlerinden sonra train veri kümesinin yapısını inceledik.

dt<-table(train$hastalik,train$DEATH_EVENT)
dt
##         
##           No Yes
##   Hasta   55  32
##   HDeğil 108  45

Train veri kümemizdeki hastalik ve DEATH_EVENT değişkenlerini kullanarak, hipertansiyon hastalığına sahip olan ve olmayan kişilere ait ölüm sayılarını içeren dt isimli tabloyu oluşturduk.

round(100*prop.table(dt,2), 2)
##         
##             No   Yes
##   Hasta  33.74 41.56
##   HDeğil 66.26 58.44

hipertansiyon hastalığına sahip olan ve olmayan kişilere ait ölüm sayılarını içeren dt isimli tabloyu kullanarak bu sayıların yüzdesel olarak ifade edildiği tabloyu oluşturduk.

library(DescTools)      
## 
## Attaching package: 'DescTools'
## The following objects are masked from 'package:psych':
## 
##     AUC, ICC, SD
## The following objects are masked from 'package:Hmisc':
## 
##     %nin%, Label, Mean, Quantile
## The following objects are masked from 'package:caret':
## 
##     MAE, RMSE
Assocs(dt)[1:3,1]
##         Phi Coeff. Contingency Coeff.           Cramer V 
##         0.07589698         0.07567932         0.07589698

DescTools paketindeki, Assocs fonksiyonundan yararlanarak dt isimli tablomuza ait Phi Katsayısını, Contingency Katsayısını ve Cramer V Katsayısın hesapladık. Cramer V Katsayısı 0.07 olarak hesaplanmıştır. Cramer V Katsayısı 0 yakın bir değer aldığı için hastalik ve DEATH_EVENT değişkenleri arasında zayıf bir birliktelik olduğunu söyleyebiliriz.

library("gplots")
## Registered S3 method overwritten by 'gplots':
##   method         from     
##   reorder.factor DescTools
## 
## Attaching package: 'gplots'
## The following object is masked from 'package:DescTools':
## 
##     reorder.factor
## The following object is masked from 'package:stats':
## 
##     lowess
balloonplot(t(dt), main ="Hastalık ve Ölüm Durumu ", xlab ="", ylab="",
            label = TRUE ,show.margins = TRUE)

gplots paketindeki, balloonplot fonksiyonu ile, dt tablosunu kaynak alarak hipertansiyon rahatsızlığı ve ölüm durumu ile ilgili bir çapraz tablo oluşturduk. Çapraz tabloyu incelediğimizde hipertansiyon rahatsızlığına sahip olmayanlarda ölü sayısının, hipertansiyon rahatsızlığı olanlara göre daha fazla olduğu görülmektedir. Buna göre kabaca hipertansiyon rahatsızlığının ölüme sebep olma olasılığı düşüktür diyebiliriz.

OR <- OddsRatio(dt, conf.level=0.95)
OR
## odds ratio     lwr.ci     upr.ci 
##  0.7161458  0.4100860  1.2506275

OddsRatio fonksiyonunu kullanarak dt tablomuza ait odds oranını hesapladık. Odds oranını 0.71 olarak bulduk. Buna göre hipertansiyon rahatsızlığına sahip olan hastaların, hipertansiyon rahatsızlığına sahip olmayan hastalara göre ölme olasılığı yaklaşık 0.7 kat daha fazladır diyebiliriz.

dt2<-xtabs(~ hastalik+sex+smoking, data=train)
dt22<-as.data.frame(ftable(dt2))

library(ggpubr)

ggballoonplot(
  dt22, x = "smoking", y = "sex",
  size = "Freq", fill = "Freq",
  facet.by = "hastalik",
  ggtheme = theme_bw())

Yukarıdaki çapraz tablo ile hipertansiyon rahatsızlığının cinsiyete ve sigara kullanımına göre nasıl bir değişkenlik gösterdiğini elde ettik. Elde edilen sonuçları incelediğimizde erkeklerde sigara kullanımının hipertansiyon rahatsızlığına sahip olup olmamasında pek bir farklılık yaratmadığını, kadınlarda ise sigara kullanmayanların kullananlara göre hipertansiyon rahatsızlığına yakalanmalarının daha fazla olduğunu söyleyebiliriz.

dt_c<-table(train$srs_kat,train$hastalik)
dtc_exp <- chisq.test(dt_c)$expected
## Warning in chisq.test(dt_c): Chi-squared approximation may be incorrect
rowcs <- function(i, obs, exp) {
  sum(((obs[i,] - exp[i,])^2)/exp[i,])
}

chi_dtc<-as.matrix(lapply(seq_len(nrow(dt_c)), rowcs, obs = dt_c, exp = dtc_exp))
rownames(chi_dtc)<-rownames(dt_c)
chi_dtc
##        [,1]      
## Düsük  0.01923706
## Normal 0.01573545
## Yüksek 0.1636241

kandaki serum sodyum oranının, hipertansiyon rahatsızlığını nasıl etkilediğine ilişkin satır ki-karelerini elde ettik. kandaki düsük ve normal serum sodyum oranları için satır ki-karelerini 0.01, yüksek için ise 0.16 olarak bulduk. Bu sonuçlara göre kandaki yüksek serum sodyum seviyesinin hipertansiyon rahatsızlığını etkilediğini ve birlikteliği bozduğunu söyleyebiliriz.

library(inspectdf)
library(dplyr)

train %>% inspect_types()
## # A tibble: 2 x 4
##   type      cnt  pcnt col_name    
##   <chr>   <int> <dbl> <named list>
## 1 factor      9  56.2 <chr [9]>   
## 2 numeric     7  43.8 <chr [7]>

Yukarıda yapmış olduğumuz işlemlerden sonra train veri kümemizin yapısını yeniden incelemeye aldık. Yaptığımız incelemelere göre veri kümemizin 9 factor ve 7 numeric değişkenden oluştuğunu ve bunların veri setinin yüzde kaçını kapsadığı sonuçlarına ulaştık.

tra_cat<-train %>% inspect_cat()
tra_cat %>% show_plot()

Train veri kümemizdeki kategorik değişkenlerin düzeyleri bazında dağılımını veren grafiği oluşturduk ve incelemelerimizi gerçekleştirdik.

library(ggplot2)
library(plotly)
## 
## Attaching package: 'plotly'
## The following object is masked from 'package:Hmisc':
## 
##     subplot
## The following object is masked from 'package:ggplot2':
## 
##     last_plot
## The following object is masked from 'package:stats':
## 
##     filter
## The following object is masked from 'package:graphics':
## 
##     layout
library(ggpubr)

ggplot2, plotly ve ggpubr paketlerini çağırdık.

cross<-as.data.frame(prop.table(table(train$smoking))) 
colnames(cross)[1] <- "smoking"
plot_ly(cross, labels = ~smoking, values = ~Freq, type = 'pie')%>% layout(title ='Sigara Kullanımına Ait  Dağılım')

Plotly paketindeki plot_ly fonksiyonundan yararlanarak sigara kullanımına ait dağılımı gösteren pie chart grafiğini elde ettik. Grafiği incelediğimizde; hastalarda sigara kullanmayanların (oranı %69.6), sigara kullananlara (oranı %30.4) göre daha fazla olduğu görülmüştür.

ggplot(train,aes(srs_kat, fill=sex))+
  geom_bar(position=position_dodge())+
  ggtitle("Serum Sodyum Seviyesi Kategorilerindeki Cinsiyet Dağılımı")+
  geom_bar() + 
  geom_text(aes(label=..count..),stat="count",position=position_stack(0.5))+
  xlab("Serum Sodyum Seviyesi Kategorileri")+
  ylab("Sıklıklar")+
  scale_fill_discrete(name = "Cinsiyet")+
  theme(axis.title.x = element_text(color="black", face="bold", size=12),
        axis.title.y = element_text(color="black", face="bold",size=12),
        plot.title = element_text(hjust = 0.5,color="black", face="bold", size=14),
        legend.title = element_text(colour="black",face="bold",size=12))

ggplot paketindeki fonksiyonları kullanarak; kandaki serum sodyum seviyesi kategorilerinin (srs_kat değişkeninin) cinsiyetlere (sex değişkenine) göre dağılım bilgisini veren bar grafiğini çizdirdik. Grafikleri incelediğimizde hastaların serum sodyum seviyesi normal olanların train veri kümesinde daha çok yer kapladığı anlaşılmıştır. Train veri kümesinde serum sodyum seviyesi düşük olan 62 kişi (41 erkek, 21 kadın), normal olan 176 kişi (111 erkek, 65 kadın) ve yüksek olan 2 kişi (1 erkek, 1 kadın) olduğu görülmüştür.

ggplot(train,aes(ejf_kat, fill=sex))+
  geom_bar(position=position_dodge())+
  ggtitle("Ejeksiyon Fraksiyonu Seviyesi Kategorilerindeki Cinsiyet Dağılımı")+
  geom_bar() + 
  geom_text(aes(label=..count..),stat="count",position=position_stack(0.5))+
  xlab("Ejeksiyon Fraksiyonu Seviyesi Kategorileri")+
  ylab("Sıklıklar")+
  scale_fill_discrete(name = "Cinsiyet")+
  theme(axis.title.x = element_text(color="black", face="bold", size=12),
        axis.title.y = element_text(color="black", face="bold",size=12),
        plot.title = element_text(hjust = 0.5,color="black", face="bold", size=14),
        legend.title = element_text(colour="black",face="bold",size=12))

ggplot paketindeki fonksiyonları kullanarak; ejeksiyon fraksiyonu seviyesi kategorilerinin (ejf_kat değişkeninin) cinsiyetlere (sex değişkenine) göre dağılım bilgisini veren bar grafiğini çizdirdik. Grafikleri incelediğimizde hastaların ejeksiyon fraksiyonu seviyesi normal olanların train veri kümesinde daha çok yer kapladığı anlaşılmıştır. Train veri kümesinde ejeksiyon fraksiyonu seviyesi düşük olan 77 kişi (53 erkek, 24 kadın), normal olan 134 kişi (86 erkek, 48 kadın) ve yüksek olan 29 kişi (14 erkek, 15 kadın) olduğu görülmüştür.

k<-ceiling((log(2*nrow(train)))+1) 
genislik_age<-max(train$age)-min(train$age)
binw_1<-genislik_age/k

ggplot(train,aes(age))+
  geom_histogram(binwidth=binw_1,
                 fill="olivedrab4",colour="black", alpha=0.6)+
  ggtitle("Hasta Yaşlarına Ait Dağılım")

ggplot paketindeki fonksiyonları kullanarak, hasta yaşlarının (age değişkeninin) dağılım bilgisini veren histogram grafiğini çizdirdik. Grafiği incelediğimizde çok az sağa çarpıklıktan bahsedebiliriz.

ggplot(train,aes(age,fill=sex))+
  geom_histogram(binwidth=binw_1)+
  facet_grid(sex~.)+
    ggtitle("Cinsiyetlere Göre Hasta Yaşlarına Ait Dağılım")

Hasta yaşlarına ait dağılım grafiğimizin, cimsiyetlere göre kırılımını gösteren histogram grafiklerini çizdirdik. Grafikleri imcelediğimizde, kadın ve erkek hastaların dağılım grafiklerinin hafif sağa çarpık olduğunu ifade edebiliriz.

ggqqplot(train$ejection_fraction)

l<-ceiling((log(2*nrow(train)))+1) 
genislik_ejection_fraction<-max(train$ejection_fraction)-min(train$ejection_fraction)
binw_2<-genislik_ejection_fraction/l

ggplot(train,aes(ejection_fraction))+
  geom_histogram(binwidth=binw_2,
                 fill="steelblue",colour="black", alpha=0.6)+
    ggtitle("Ejeksiyon Fraksiyon Seviyesine Ait Dağılım")

Ejeksiyon fraksiyon seviyesine ait Q-Q plot ve histogram grafiklerini çizdirdik. Ejeksiyon fraksiyon seviyesi Q-Q plot grafiğini incelediğimizde merdiven biçiminde bir grafik olduğu için çarpıklık olduğu kesindir, aykırı ve uç değerler vardır.Uygun dönüşüm yapılıp tekrardan incelenmelidir.

ggplot(train, aes(x = ejf_kat, y = age, fill = DEATH_EVENT)) +
  geom_boxplot(position = position_dodge(width = 0.9)) +
  stat_summary(fun = median,geom = 'line',
               aes(group = DEATH_EVENT, colour = DEATH_EVENT),size=1,
               position = position_dodge(width = 0.9))

Grafiği incelediğimizde; ejeksiyon fraksiyon seviyesi (kalbin her kasılmasında ortaya çıkan kan yüzdesi) düşük olup hayatını kaybetmiş olan hastaların kutu genişliğine bakıldığında, geniş bir yaş dağılımına sahip oldukları görülmektedir. Buna göre ölümlerin yaşın genç olması ya da yaşlı olmasına değilde ejeksiyon fraksiyon seviyesine bağlı olarak ortaya çıkan kalp yetmezliğine bağlı olduğunu söyleyebiliriz.

library(tidyverse)
## -- Attaching packages --------------------------------------- tidyverse 1.3.1 --
## v tibble  3.1.6     v purrr   0.3.4
## v tidyr   1.2.0     v stringr 1.4.0
## v readr   2.1.2     v forcats 0.5.1
## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x psych::%+%()       masks ggplot2::%+%()
## x psych::alpha()     masks ggplot2::alpha()
## x plotly::filter()   masks dplyr::filter(), mice::filter(), stats::filter()
## x dplyr::lag()       masks stats::lag()
## x purrr::lift()      masks caret::lift()
## x Hmisc::src()       masks dplyr::src()
## x Hmisc::summarize() masks dplyr::summarize()

tidyverse paketini çağırdık.

ggplot(train, aes(serum_creatinine, ejection_fraction))+
  geom_point(size=2,shape=21,stroke=1,color="deepskyblue3", fill="deepskyblue3")+
  geom_smooth(method = "lm", col="darkblue",se = FALSE)
## `geom_smooth()` using formula 'y ~ x'

İkili değişken dağılımı incelendiğinde yoğunluğun serum kreatinin seviyesinin düşük olduğu aralıkta yoğunlaştığı söylenebilir. Değişen varyanslılıktan söz edilemez.

library(plotly)
d_plot <- ggplot(train, aes(serum_creatinine, ejection_fraction, fill=DEATH_EVENT, shape=DEATH_EVENT)) +
  geom_point(position = position_jitter(width= 0.2, height = 0), size = 2)

ggplotly(d_plot)

ejeksiyon fraksiyon seviyesine (kalbin her kasılmasında ortaya çıkan kan yüzdesi) bağlı serum kreatinin seviyesi ve ölüm sayısının dağılım grafiği incelendiğinde serum kreatinin seviyesi değeri düşükl aralıkta olan kişilerde mavi renge sahip olan üçgenlerin daha fazla olduğu görülmektedir. Buna göre serum kreatinin seviyesi değeri düşük olan kişilerde ölüm daha fazladır diyebiliriz.

library(ggExtra)
gr<-ggplot(train,aes(x=serum_creatinine,y=ejection_fraction))+
  geom_point()+
  geom_text(size=3,label=rownames(train),nudge_x=0.25,
            nudge_y=0.25, check_overlap=T)+
  geom_smooth(method=lm,col="brown1", se=FALSE)

ggMarginal(gr,type="histogram",fill="darksalmon")
## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'

ejeksiyon fraksiyon seviyesi değişkeninin (kalbin her kasılmasında ortaya çıkan kan yüzdesi) serum kreatinin seviyesi değişkeni ile dağılımı incelendiğinde iki değişken arasında doğrusal bir ilişki olmadığı söylenebilir. İleride yapılacak incelemelerde değişkenlere gereken dönüşümler yapılarak ve aykırı değerler çıkartılarak bu durum giderilebilir.

cor_train<-train[,c(8,7,5)]
panel.cor <- function(x,y,digits=2,prefix="",cex.cor)       
{
  usr <- par("usr"); on.exit(par(usr))
  par(usr=c(0,1,0,1))
  r=(cor(x,y))
  txt <- format(c(r,0.123456789),digits=digits)[1]
  txt <- paste(prefix, txt, sep="")
  if(missing(cex.cor)) cex <- 0.8/strwidth(txt)
  text(0.5, 0.5, txt, cex=cex*abs(r))
}
panel.hist <- function(x, ...)
{
  usr <- par("usr"); on.exit(par(usr))
  par(usr = c(usr[1:2], 0, 1.5) )
  h <- hist(x, plot = FALSE)
  breaks <- h$breaks; nB <- length(breaks)
  y <- h$counts; y <- y/max(y)
  rect(breaks[-nB], 0, breaks[-1], y, col="cyan", ...)
}

pairs(cor_train, lower.panel=panel.smooth, upper.panel=panel.cor)

pairs(cor_train, diag.panel=panel.hist, lower.panel=panel.smooth, upper.panel=panel.cor)

pairs(cor_train, diag.panel=panel.hist,lower.panel=function(x,y) panel.smooth(x, y, pch=".", lwd=2), upper.panel=panel.cor)

serum kreatinin seviyesi, platelets (kandaki trambositler) ve ejeksiyon fraksiyon seviyesi(kalbin her kasılmasında ortaya çıkan kan yüzdesi) değişkenleri için saçılım grafikleri çizdirildi. Saçılım grafikleri incelendiğinde değişkenler arasında anlamlı bir ilişkinin varlığından söz edilemez. Gerekli dönüşümler yapılarak bu sorun giderilebilir.

library(rcompanion)
## 
## Attaching package: 'rcompanion'
## The following object is masked from 'package:psych':
## 
##     phi

rcompanion paketini markdown içerisinde aktif hale getirdik.

serum_creatinine_tukey<-transformTukey(train$serum_creatinine,plotit=FALSE)
## 
##     lambda      W Shapiro.p.value
## 360 -1.025 0.9846         0.01051
## 
## if (lambda >  0){TRANS = x ^ lambda} 
## if (lambda == 0){TRANS = log(x)} 
## if (lambda <  0){TRANS = -1 * x ^ lambda}

Serum kreatinin değişkeninin lamda değeri -1.15 olarak bulunmuştur. Bu değer sıfırdan küçük olduğu için ters kök değişimi uygulanarak var olan sağa çarpıklığı simetrik hale getirmeye çalışalım.

train$serum_creatinine_terskok <- (train$serum_creatinine)^(-0.5)
hist(train$serum_creatinine, col = "palevioletred3")

hist(train$serum_creatinine_terskok, col = "palevioletred3")

serum kreatinin değişkenine ters kök dönüşümü uygulandı ve serum kreatinin ters kök değişkeni olarak kaydedildi. Serum kreatinin değişkeninin ve serum kreatinin ters kök değişkeninin histogram grafiği çizdirildi. Histogram grafikleri incelendiğinde ters kök dönüşümü uygulandıktan sonra, serum kreatinin dağılımının sağa çarpıklıktan kurtulduğu ve daha simetrik bir forma kavuştuğu gözlemlenmiştir.

platelets_tukey<-transformTukey(train$platelets,plotit=FALSE)
## 
##     lambda      W Shapiro.p.value
## 420  0.475 0.9578       1.705e-06
## 
## if (lambda >  0){TRANS = x ^ lambda} 
## if (lambda == 0){TRANS = log(x)} 
## if (lambda <  0){TRANS = -1 * x ^ lambda}

platelets değişkeninin (kandaki trambositler) lamda değeri 0.45 olarak hesaplanmıştır. Bu değeri en yakın yuvarkayacağımız değer 0.5’tir. Bu yüzden kök dönüşümü uygulayarak hafif sağa çarpıklığı gidermeliyiz.

train$platelets_sqrt<-sqrt(train$platelets)
hist(train$platelets, col = "aquamarine3")

hist(train$platelets_sqrt, col = "aquamarine3")

platelets değişkenine kök dönüşümü uygulandı ve platelets_sqrt değişkeni olarak kaydedildi. platelets değişkeninin ve platelets_sqrt değişkeninin histogram grafiği çizdirildi. Histogram grafikleri incelendiğinde kök dönüşümü uygulandıktan sonra, platelets dağılımının hafif sağa çarpıklıktan kurtulduğu ve daha simetrik bir forma kavuştuğu gözlemlenmiştir.

ejection_fraction_tukey<- transformTukey(train$ejection_fraction, plotit=FALSE)
## 
##     lambda      W Shapiro.p.value
## 410  0.225 0.9646       1.137e-05
## 
## if (lambda >  0){TRANS = x ^ lambda} 
## if (lambda == 0){TRANS = log(x)} 
## if (lambda <  0){TRANS = -1 * x ^ lambda}

Ejeksiyon fraksiyon lamda değeri 0.225 olarak hesaplanmıştır. Bu değeri sıfıra eşit kabul ederek logaritma (log) dönüşümü uygulamalıyız .

train$ejection_fraction_log<-log10(train$ejection_fraction)
hist(train$ejection_fraction, col = "turquoise4")

hist(train$ejection_fraction_log, col = "turquoise4")

ejection_fraction değişkenine logaritma (log) dönüşümü uygulandı ve ejection_fraction_log değişkeni olarak kaydedildi. ejection_fraction değişkeninin ve ejection_fraction_log değişkeninin histogram grafiği çizdirildi. Histogram grafikleri incelendiğinde logaritma (log) dönüşümü uygulandıktan sonra, ejection_fraction dağılımının hafif sağa çarpıklıktan kurtulduğu ve daha simetrik bir forma kavuştuğu gözlemlenmiştir.

gr<-ggplot(train,aes(x=serum_creatinine_terskok,y=ejection_fraction_log))+
  geom_point()+
  geom_text(size=3,label=rownames(train),nudge_x=0.25,
            nudge_y=0.25, check_overlap=T)+
  geom_smooth(method=lm,col="brown1", se=FALSE)

ggMarginal(gr,type="histogram",fill="darksalmon")
## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'

serum kreatinin ve ejeksiyon fraksiyon değişkenlerine dönüşüm uygulandıktan sonra saçılım grafiklerini yeniden çizdirdik. Grafiği incelediğimizde dönüşüm işlemine rağmen serum kreatinin ile ejeksiyon fraksiyon arasında hala doğrusal bir ilişki olmadığı söylenebilir. Çok fazla uç değer bulunmaktadır.

cor_train<-train[,c(17,18,19)]
panel.cor <- function(x,y,digits=2,prefix="",cex.cor)       
{
  usr <- par("usr"); on.exit(par(usr))
  par(usr=c(0,1,0,1))
  r=(cor(x,y))
  txt <- format(c(r,0.123456789),digits=digits)[1]
  txt <- paste(prefix, txt, sep="")
  if(missing(cex.cor)) cex <- 0.8/strwidth(txt)
  text(0.5, 0.5, txt, cex=cex*abs(r))
}
panel.hist <- function(x, ...)
{
  usr <- par("usr"); on.exit(par(usr))
  par(usr = c(usr[1:2], 0, 1.5) )
  h <- hist(x, plot = FALSE)
  breaks <- h$breaks; nB <- length(breaks)
  y <- h$counts; y <- y/max(y)
  rect(breaks[-nB], 0, breaks[-1], y, col="cyan", ...)
}

pairs(cor_train, lower.panel=panel.smooth, upper.panel=panel.cor)

pairs(cor_train, diag.panel=panel.hist, lower.panel=panel.smooth, upper.panel=panel.cor)

pairs(cor_train, diag.panel=panel.hist,lower.panel=function(x,y) panel.smooth(x, y, pch=".", lwd=2), upper.panel=panel.cor)

Gerekli dönüşümler yapıldıktan sonra saçılım grafiklerini karşılaştırdığımızda dönüşüm yapılmamış saçılım grafiği ilişki değerleri dönüşüm yapılan grafiğe göre daha düşüktür. Dönüşüm yapılan saçılım grafiği ilişi katsayıları yüksektir fakat değişkenler araasında doğrusal bir ilişki olduğu söylenemez. Modelleme adımında değişkenlere gerekli dönüşümler uygulanıp tekrardan denenebilir.

table3 <- xtabs(~sex+ejf_kat+smoking, data = train)
ftable(table3)
##                smoking No Yes
## sex    ejf_kat               
## Female Düsük           23   1
##        Normal          47   1
##        Yüksek          14   1
## Male   Düsük           29  24
##        Normal          46  40
##        Yüksek           8   6

Cinsiyetlerin ejeksiyon fraksiyon (kalbin her kasılmasında ortaya çıkan kan yüzdesi) kategorilerinde sigara kullanımını gösteren tabloyu oluşturduk.

library(ggplot2)
library(ggmosaic)

ggplot2 ve ggmosaic paketlerini markdown içerisinde aktif hale getirdik.

ggplot(train) +
  geom_mosaic(aes(x = product(sex, smoking), fill=sex), na.rm=TRUE) +  labs(x = "Sigara Kullanımı ", title='Kalp Kasılmasında Ortaya Çıkan Kan Yüzdesi Kategorisi, Cinsiyet  ve Sigara ') + 
  facet_grid(ejf_kat~.)
## Warning: `unite_()` was deprecated in tidyr 1.2.0.
## Please use `unite()` instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was generated.

Tabloyu incelediğimizde ejeksiyon fraksiyon kategorisi yüksek olan erkeklerin sigara kullanma frekansı da yüksektir. Kadnlarda bu durum erkeklere göre daha düşüktür.

library(aplpack)
## Registered S3 method overwritten by 'aplpack':
##   method       from     
##   plot.bagplot DescTools
## 
## Attaching package: 'aplpack'
## The following object is masked from 'package:DescTools':
## 
##     plot.bagplot
library(dplyr)

aplpack ve dplyr paketlerini markdown içerisinde aktif hale getirdik.

new_data<-train%>%
  group_by(ejf_kat) %>%
  dplyr::summarize(mean_ejf = mean(ejection_fraction),mean_plt = mean(platelets),mean_yas = mean(age))
faces(new_data[,-1],  labels=as.character(new_data$ejf_kat))

## effect of variables:
##  modified item       Var       
##  "height of face   " "mean_ejf"
##  "width of face    " "mean_plt"
##  "structure of face" "mean_yas"
##  "height of mouth  " "mean_ejf"
##  "width of mouth   " "mean_plt"
##  "smiling          " "mean_yas"
##  "height of eyes   " "mean_ejf"
##  "width of eyes    " "mean_plt"
##  "height of hair   " "mean_yas"
##  "width of hair   "  "mean_ejf"
##  "style of hair   "  "mean_plt"
##  "height of nose  "  "mean_yas"
##  "width of nose   "  "mean_ejf"
##  "width of ear    "  "mean_plt"
##  "height of ear   "  "mean_yas"

train veri kümesindeki ejeksiyon fraksiyonu değişkeni için ejf_kat, platelets ve age değişkenlerinden yararlanarak Chernoff yüzleri oluşturuldu.

Chernoff yüzlerini incelediğimizde ejeksiyon fraksiyon seviyesinin düşük kategorisinde ağız, göz, burun ve kulağın şekil açısından diğerlerine kıyasla daha dar ve küçük bir yapıya sahip olduğu görülüyor.Yani değişken değerlerinin daha düşük olduğunu söyleyebiliriz. Ejeksiyon fraksiyon seviyesinin normal kategorisine ait chernoff yüzünü incelersek; ağız kısmında smiling yoktur. Yani yaş ortalamasının en düşük olduğu kategori olduğunu söyleyebiliriz. Yüzdeki organların normal düzeylerde şekillendiği söylenebilir. Yani değişken değerleri normal düzeyde dağılmaktadır. Ejeksiyon fraksiyon seviyesinin yüksek kategorisinde ki chernoff yüzünün daha güleç ve yüzdeki organların daha büyük düzeylerde şekillendiği söylenebilir. Yani değişken değerlerinin daha büyük olduğunu söyleyebiliriz. Saçlar ise yukarıya doğru bakıyor. Bu durum bize yaş ortalaması en büyük olan kategorinin yüksek kategorisi olduğunu söylemektedir.

5. Modelleme

test <- read_excel("test.xlsx")
test$anaemia <- as.factor(test$anaemia)
test$diabetes <- as.factor(test$diabetes)
test$high_blood_pressure <- as.factor(test$high_blood_pressure)
test$sex <- as.factor(test$sex)
test$smoking <- as.factor(test$smoking)
test$DEATH_EVENT <- as.factor(test$DEATH_EVENT)

Test veri kümemizi markdowna aktardık. Sonrasında veri kümemizde yer alan kategorik değişkenleri as.factor fonksiyonu yardımı ile factor formatına çevirdik.

summary(test)
##       age        anaemia  creatinine_phosphokinase diabetes ejection_fraction
##  Min.   :40.00   No :38   Min.   :  23.0           No :43   Min.   :15.00    
##  1st Qu.:50.00   Yes:21   1st Qu.: 185.0           Yes:16   1st Qu.:30.00    
##  Median :60.00            Median : 482.0                    Median :38.00    
##  Mean   :60.66            Mean   : 738.1                    Mean   :38.44    
##  3rd Qu.:70.00            3rd Qu.: 585.0                    3rd Qu.:45.00    
##  Max.   :86.00            Max.   :7861.0                    Max.   :80.00    
##  high_blood_pressure   platelets      serum_creatinine  serum_sodium  
##  No :41              Min.   : 51000   Min.   :0.600    Min.   :128.0  
##  Yes:18              1st Qu.:209000   1st Qu.:1.000    1st Qu.:134.0  
##                      Median :255000   Median :1.100    Median :136.0  
##                      Mean   :251682   Mean   :1.398    Mean   :136.0  
##                      3rd Qu.:292500   3rd Qu.:1.350    3rd Qu.:138.5  
##                      Max.   :621000   Max.   :6.100    Max.   :145.0  
##      sex     smoking       time       DEATH_EVENT
##  Female:18   No :36   Min.   :  4.0   No :40     
##  Male  :41   Yes:23   1st Qu.: 76.0   Yes:19     
##                       Median :120.0              
##                       Mean   :130.4              
##                       3rd Qu.:193.5              
##                       Max.   :258.0

Test veri kümemizin yapısını inceledik ve yapmış olduğumuz dönüşümleri kontrol ettik.

test$serum_creatinine_terskok <- (test$serum_creatinine)^(-0.5)
test$platelets_sqrt<-sqrt(test$platelets)
test$ejection_fraction_log<-log10(test$ejection_fraction)

Train veri kümemizde uygulamış olduğumuz ters kök, kök ve logaritma dönüşümlerini, test veri kümemizde de gerçekleştirdik.

library(rpart)
library(rpart.plot)

rpart ve rpart.plot paketlerini markdowm içerisinde aktif hale getirdik.

cart<-rpart(ejection_fraction~ejection_fraction_log+serum_creatinine_terskok+sex+smoking , data=train)
cart$variable.importance
##    ejection_fraction_log serum_creatinine_terskok                      sex 
##               32432.2823                1591.5354                 740.9592 
##                  smoking 
##                 319.3603

Değişkenlerimizin önem dereceleri incelediğimizde, en yüksek değerin logaritmik dönüşüm uyguladığımız ejeksiyon fraksiyon değişkeninin olduğu görülmektedir.

rpart.plot(cart)

Karar ağacımız, ejeksiyon fraksiyon değişkenine göre oluşturuldu. Sonuç olarak en yüksek oran %25 bulundu.

defaultSummary(data.frame(obs=train$ejection_fraction_log,pred=predict(cart,train)))
##       RMSE   Rsquared        MAE 
## 38.2061768  0.9497933 36.4371629
defaultSummary(data.frame(obs=test$ejection_fraction_log,pred=predict(cart,test)))
##       RMSE   Rsquared        MAE 
## 38.3672432  0.9351165 36.7435635

Train ve test veri kümeleri için predict cart tahminlemesi gerçekleştirildi.

train$Target<-ifelse(train$creatinine_phosphokinase<= 120,"HDegil","Hasta")
train$Target<-as.factor(train$Target)
test$Target<-ifelse(test$creatinine_phosphokinase<=120,"HDegil","Hasta")
test$Target<-as.factor(test$Target)

Train ve test veri kümemizdeki, creatinine_phosphokinase nicel değişkeni sınıflandırma problemine dönüştürülmek için kategorik forma çevrildi. Sonrasında as.factor fonksiyonu yardımıyla factor olarak tanımlatıldı.

clsf_rpart<-rpart(Target~ platelets_sqrt+sex+smoking, data=train, method="class")
rpart.plot(clsf_rpart)

Target, platelets_sqrt, sex ve smoking değişkenleri kullanılarak modelleme gerçekleştirildi ve karar ağacı çizdirildi. Karar ağacı incelendiğinde dallanmanın platelets değişkenine (kandaki trambosit oranı) göre oluştuğu görülüyor. Dallandırma sonuçlarına göre hasta olma oranının %92, hasta olmama oranının ise %8 olduğu görülmektedir.

library(caret)
library(iterators)

caret ve iterators paketlerini markdowm içerisinde aktif hale getirdik.

tb<-table(predict(clsf_rpart, train, type="class"),train$Target)
tb
##         
##          Hasta HDegil
##   Hasta    170     50
##   HDegil     5     15

Oluşturulan tabloyu incelediğimizde, train veri kümesinde 220 kişinin hasta olduğu, 20 kişinin de hasta olmadığı anlaşılmıştır. Ancak modelimiz, train veri kümesinde gerçekte hasta olan 50 kişiyi hasta değil, hasta olmayan 5 kişiyi de hasta olarak sınıflandırmıştır.

confusionMatrix(tb,positive="Hasta")
## Confusion Matrix and Statistics
## 
##         
##          Hasta HDegil
##   Hasta    170     50
##   HDegil     5     15
##                                           
##                Accuracy : 0.7708          
##                  95% CI : (0.7124, 0.8224)
##     No Information Rate : 0.7292          
##     P-Value [Acc > NIR] : 0.0821          
##                                           
##                   Kappa : 0.2584          
##                                           
##  Mcnemar's Test P-Value : 2.975e-09       
##                                           
##             Sensitivity : 0.9714          
##             Specificity : 0.2308          
##          Pos Pred Value : 0.7727          
##          Neg Pred Value : 0.7500          
##              Prevalence : 0.7292          
##          Detection Rate : 0.7083          
##    Detection Prevalence : 0.9167          
##       Balanced Accuracy : 0.6011          
##                                           
##        'Positive' Class : Hasta           
## 

Train veri kümemizin doğruluk değeri %77’dir. Modelimiz gerçekte hasta olan kişilerin %97’sine doğru karar vermiştir. Fakat gerçekte hasta olmayan kişilerin %23’lük kısmına da hasta demiştir.

tb2<-table(predict(clsf_rpart, test, type="class"),test$Target)
tb2
##         
##          Hasta HDegil
##   Hasta     44     11
##   HDegil     3      1

Oluşturulan tabloyu incelediğimizde, test veri kümesinde 55 kişinin hasta olduğu, 4 kişinin de hasta olmadığı anlaşılmıştır. Ancak modelimiz, test veri kümesinde gerçekte hasta olan 11 kişiyi hasta değil, hasta olmayan 3 kişiyi de hasta olarak sınıflandırmıştır.

confusionMatrix(tb2,positive="Hasta")
## Confusion Matrix and Statistics
## 
##         
##          Hasta HDegil
##   Hasta     44     11
##   HDegil     3      1
##                                           
##                Accuracy : 0.7627          
##                  95% CI : (0.6341, 0.8638)
##     No Information Rate : 0.7966          
##     P-Value [Acc > NIR] : 0.79389         
##                                           
##                   Kappa : 0.0259          
##                                           
##  Mcnemar's Test P-Value : 0.06137         
##                                           
##             Sensitivity : 0.93617         
##             Specificity : 0.08333         
##          Pos Pred Value : 0.80000         
##          Neg Pred Value : 0.25000         
##              Prevalence : 0.79661         
##          Detection Rate : 0.74576         
##    Detection Prevalence : 0.93220         
##       Balanced Accuracy : 0.50975         
##                                           
##        'Positive' Class : Hasta           
## 

Test veri kümemizin doğruluk değeri %76’dır. Modelimiz gerçekte hasta olan kişilerin %93’üne doğru karar vermiştir. Fakat gerçekte hasta olmayan kişilerin %8’lik kısmına da hasta demiştir.

SONUÇ:

Kardiyovasküler hastalıklar (KVH)’ın farklı değişkenlerini (nitel ve nicel) içeren veri seti ile analizler gerçekleştirdik. İlk olarak veri setinde NA gözlem araştırması yaptık. Yapılan araştırmada veri setinin NA gözlem içermediği bilgisine ulaştık. Sonraki adımda veri seti için rastgele NA gözlem yaratıp tahmine dayalı doldurduk. Ardından serum sodyum ve ejeksiyon fraksiyon değişkenlerini kategorilerine ayırdık. İşlemlerimize değişkenlerin grafiklerini, çeyreklilk, DAG vb değerlerini inceleyerek devam ettik. Bu işlemlerin ardından veri setinde normal dağılmayan değişkenler için uygun dönüşüm işlemlerini gerçekleştirdik. Sonrasında ileri grafiklere başvurarak veri setimiz hakkkında daha da detaylı bilgilere ulaştık. Bir sonraki adımda veri setimiz için bir model oluşturduk ve tahminler gerçekleştirdik. Son olarak ise modelimizle elde etmiş olduğumuz tahminlerin train ve test veri kümeleri için hata matrislerini oluşturduk.